home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / spectcl-.000 / spectcl- / usr / local / SpecTcl-0.1a / menubar.menu.tcl < prev    next >
Encoding:
Text File  |  1995-12-01  |  8.0 KB  |  351 lines
  1. # SpecTcl, by S. A. Uhler
  2. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  3. #
  4. # See the file "license.txt" for information on usage and redistribution
  5. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  6. #
  7. # Menu generated from menubar.menu
  8. # menubar is a frame in your interface which the menu uses as its menu bar.
  9.  
  10. proc menubar_menu {menubar args} {
  11.  
  12.  
  13.     # this treats "." as a special case
  14.     if {$menubar == "."} {
  15.         set mbar_widget "."
  16.         set menubar ""
  17.     } else {
  18.         set mbar_widget $menubar
  19.     }
  20.  
  21.  
  22.     set bind_widget [winfo toplevel $mbar_widget]
  23.  
  24.     $menubar configure -borderwidth 2
  25.     $menubar configure -relief raised
  26.     menubutton $menubar.mnu#1\
  27.         -text File\
  28.         -menu $menubar.mnu#1.menu\
  29.         -underline 0
  30.     pack $menubar.mnu#1 -side left
  31.  
  32.     menu $menubar.mnu#1.menu\
  33.         -postcommand {}\
  34.         -tearoff 0
  35.  
  36.     $menubar.mnu#1.menu add command\
  37.         -label New\
  38.         -underline -1\
  39.         -command clear_all\
  40.         -accelerator <Control-n>
  41.  
  42.     bind $bind_widget <Control-n> clear_all
  43.  
  44.  
  45.     $menubar.mnu#1.menu add command\
  46.         -label Open...\
  47.         -underline -1\
  48.         -command {catch {destroy .open}; open_ui [toplevel .open]}\
  49.         -accelerator <Control-o>
  50.  
  51.     bind $bind_widget <Control-o> {catch {destroy .open}; open_ui [toplevel .open]}
  52.  
  53.  
  54.     $menubar.mnu#1.menu add command\
  55.         -label Save\
  56.         -underline -1\
  57.         -command {save_project  $Current(project).$P(file_suffix) 1}
  58.  
  59.     $menubar.mnu#1.menu add command\
  60.         -label {Save as ...}\
  61.         -underline -1\
  62.         -command {catch {destroy .save};save_ui [toplevel .save]}
  63.  
  64.     $menubar.mnu#1.menu add separator
  65.     $menubar.mnu#1.menu add command\
  66.         -label Quit\
  67.         -underline -1\
  68.         -command quit\
  69.         -accelerator <Control-x>
  70.  
  71.     bind $bind_widget <Control-x> quit
  72.  
  73.  
  74.     menubutton $menubar.mnu#8\
  75.         -text Edit\
  76.         -menu $menubar.mnu#8.menu\
  77.         -underline 0
  78.     pack $menubar.mnu#8 -side left
  79.  
  80.     menu $menubar.mnu#8.menu\
  81.         -postcommand editmenu_active\
  82.         -tearoff 0
  83.  
  84.     $menubar.mnu#8.menu add command\
  85.         -label {Edit code}\
  86.         -underline -1\
  87.         -command {edit_code $Current(project)}\
  88.         -accelerator <Control-e>
  89.  
  90.     bind $bind_widget <Control-e> {edit_code $Current(project)}
  91.  
  92.  
  93.     $menubar.mnu#8.menu add command\
  94.         -label {Widget options ...}\
  95.         -underline -1\
  96.         -command menu_widget\
  97.         -accelerator <Control-w>
  98.  
  99.     bind $bind_widget <Control-w> menu_widget
  100.  
  101.  
  102.     $menubar.mnu#8.menu add command\
  103.         -label {Generic options ...}\
  104.         -underline -1\
  105.         -command menu_generic\
  106.         -accelerator <Control-g>
  107.  
  108.     bind $bind_widget <Control-g> menu_generic
  109.  
  110.  
  111.     $menubar.mnu#8.menu add separator
  112.     $menubar.mnu#8.menu add command\
  113.         -label Delete\
  114.         -underline -1\
  115.         -command delete_selected\
  116.         -accelerator <Delete>
  117.  
  118.     bind $bind_widget <Key-Delete> delete_selected
  119.  
  120.  
  121.     $menubar.mnu#8.menu add command\
  122.         -label Cut\
  123.         -underline -1\
  124.         -command {to_clipboard; delete_selected 0}\
  125.         -accelerator <Control-x>
  126.  
  127.     bind $bind_widget <Control-x> {to_clipboard; delete_selected 0}
  128.  
  129.  
  130.     $menubar.mnu#8.menu add command\
  131.         -label Copy\
  132.         -underline -1\
  133.         -command to_clipboard\
  134.         -accelerator <Control-c>
  135.  
  136.     bind $bind_widget <Control-c> to_clipboard
  137.  
  138.  
  139.     $menubar.mnu#8.menu add command\
  140.         -label Paste\
  141.         -underline -1\
  142.         -command from_clipboard\
  143.         -accelerator <Control-v>
  144.  
  145.     bind $bind_widget <Control-v> from_clipboard
  146.  
  147.  
  148.     menubutton $menubar.mnu#17\
  149.         -text Commands\
  150.         -menu $menubar.mnu#17.menu\
  151.         -underline 0
  152.     pack $menubar.mnu#17 -side left
  153.  
  154.     menu $menubar.mnu#17.menu\
  155.         -postcommand commandmenu_active\
  156.         -tearoff 0
  157.  
  158.     $menubar.mnu#17.menu add command\
  159.         -label {Build & Test}\
  160.         -underline -1\
  161.         -command {build_app $Current(project).$P(file_suffix) /usr/local/bin/bltt_wish}\
  162.         -accelerator <Control-t>
  163.  
  164.     bind $bind_widget <Control-t> {build_app $Current(project).$P(file_suffix) /usr/local/bin/bltt_wish}
  165.  
  166.  
  167.     $menubar.mnu#17.menu add command\
  168.         -label {Kill test}\
  169.         -underline -1\
  170.         -command { catch {send  $Current(test_app) {after 1 {exit 0}}}}
  171.  
  172.     $menubar.mnu#17.menu add command\
  173.         -label {Attach scrollbars}\
  174.         -underline -1\
  175.         -command {set _Message [scroll_attach]}
  176.  
  177.     $menubar.mnu#17.menu add command\
  178.         -label {Re-apply toolbar}\
  179.         -underline -1\
  180.         -command {eval $Current(repeat); set _Message "repeating: $Current(repeat)"}\
  181.         -accelerator <Control-.>
  182.  
  183.     bind $bind_widget <Control-Key-period> {eval $Current(repeat); set _Message "repeating: $Current(repeat)"}
  184.  
  185.  
  186.     menu $menubar.mnu#17.menu.mnu#22\
  187.         -tearoff 0
  188.  
  189.     $menubar.mnu#17.menu add cascade\
  190.         -label Navigate\
  191.         -menu $menubar.mnu#17.menu.mnu#22\
  192.         -underline -1\
  193.         -command {}
  194.  
  195.     $menubar.mnu#17.menu.mnu#22 add command\
  196.         -label {Next widget}\
  197.         -underline -1\
  198.         -command {short_cut Right}\
  199.         -accelerator <Right>
  200.  
  201.     bind $bind_widget <Key-Right> {short_cut Right}
  202.  
  203.  
  204.     $menubar.mnu#17.menu.mnu#22 add command\
  205.         -label {Previous widget}\
  206.         -underline -1\
  207.         -command {short_cut Left}\
  208.         -accelerator <Left>
  209.  
  210.     bind $bind_widget <Key-Left> {short_cut Left}
  211.  
  212.  
  213.     $menubar.mnu#17.menu.mnu#22 add command\
  214.         -label {Enter subgrid}\
  215.         -underline -1\
  216.         -command Key_down\
  217.         -accelerator <Down>
  218.  
  219.     bind $bind_widget <Key-Down> Key_down
  220.  
  221.  
  222.     $menubar.mnu#17.menu.mnu#22 add command\
  223.         -label {Leave subgrid}\
  224.         -underline -1\
  225.         -command Key_up\
  226.         -accelerator <Up>
  227.  
  228.     bind $bind_widget <Key-Up> Key_up
  229.  
  230.  
  231.     menubutton $menubar.mnu#27\
  232.         -text Preferences\
  233.         -menu $menubar.mnu#27.menu\
  234.         -underline 0
  235.     pack $menubar.mnu#27 -side left
  236.  
  237.     menu $menubar.mnu#27.menu\
  238.         -postcommand {}\
  239.         -tearoff 0
  240.  
  241.     $menubar.mnu#27.menu add checkbutton\
  242.         -label {Show grid}\
  243.         -command toggle_grid\
  244.         -underline -1\
  245.         -variable Grid
  246.  
  247.     $menubar.mnu#27.menu add checkbutton\
  248.         -label {Show help}\
  249.         -command {test_help $P(help)}\
  250.         -underline -1\
  251.         -variable P(help)
  252.  
  253.     menubutton $menubar.mnu#30\
  254.         -text Help\
  255.         -menu $menubar.mnu#30.menu\
  256.         -underline 0
  257.     pack $menubar.mnu#30 -side left
  258.  
  259.     menu $menubar.mnu#30.menu\
  260.         -postcommand {}\
  261.         -tearoff 0
  262.  
  263.     $menubar.mnu#30.menu add command\
  264.         -label about\
  265.         -underline -1\
  266.         -command about
  267.  
  268.     $menubar.mnu#30.menu add command\
  269.         -label {getting started}\
  270.         -underline -1\
  271.         -command {html_help quick.html}\
  272.         -accelerator <Help>
  273.  
  274.     bind $bind_widget <Key-Help> {html_help quick.html}
  275.  
  276.  
  277.     $menubar.mnu#30.menu add command\
  278.         -label help\
  279.         -underline -1\
  280.         -command html_help
  281.  
  282. }
  283.  
  284.  
  285. #
  286. # Procedure to map user-supplied labels into actual widget names
  287. # Parameters are as follows:
  288. #     menubar: Name of the frame widget which acts as the menubar
  289. #              for the menu in your application.
  290. #     itemlabel: The textual label appearing on the menu item.
  291. #
  292. # Note: For items in menus (radiobuttons, checkbuttons, commands, 
  293. #       separators, cascades) the name returned is the menu to which
  294. #       that item belongs.  Items in menus are not actually widgets.
  295. #       To configure them, use entryconfigure:
  296. #          <menu name> entryconfigure <label of item> -<option> <value>
  297. #       For example:
  298. #          set menu_name myMenu_getmenuname {.f "File"}
  299. #          $menu_name entryconfigure "File" -background red
  300. #
  301. proc menubar_getmenuname {menubar itemlabel} {
  302.  
  303.  
  304.     # this treats "." as a special case
  305.     if {$menubar == "."} {
  306.         set menubar ""
  307.     }
  308.  
  309.     global menubar_map
  310.     array set menubar_map {
  311.         File $menubar.mnu#1
  312.         {Previous widget} $menubar.mnu#17.menu.mnu#22
  313.         New $menubar.mnu#1.menu
  314.         {Widget options ...} $menubar.mnu#8.menu
  315.         about $menubar.mnu#30.menu
  316.         Copy $menubar.mnu#8.menu
  317.         Quit $menubar.mnu#1.menu
  318.         {Generic options ...} $menubar.mnu#8.menu
  319.         Delete $menubar.mnu#8.menu
  320.         {Attach scrollbars} $menubar.mnu#17.menu
  321.         {Kill test} $menubar.mnu#17.menu
  322.         Cut $menubar.mnu#8.menu
  323.         Paste $menubar.mnu#8.menu
  324.         {Save as ...} $menubar.mnu#1.menu
  325.         {Enter subgrid} $menubar.mnu#17.menu.mnu#22
  326.         {Build & Test} $menubar.mnu#17.menu
  327.         Edit $menubar.mnu#8
  328.         Navigate $menubar.mnu#17.menu
  329.         Save $menubar.mnu#1.menu
  330.         help $menubar.mnu#30.menu
  331.         {getting started} $menubar.mnu#30.menu
  332.         Help $menubar.mnu#30
  333.         {Edit code} $menubar.mnu#8.menu
  334.         {Show help} $menubar.mnu#27.menu
  335.         Preferences $menubar.mnu#27
  336.         Commands $menubar.mnu#17
  337.         {Next widget} $menubar.mnu#17.menu.mnu#22
  338.         Open... $menubar.mnu#1.menu
  339.         {Leave subgrid} $menubar.mnu#17.menu.mnu#22
  340.         {Re-apply toolbar} $menubar.mnu#17.menu
  341.         {Show grid} $menubar.mnu#27.menu
  342.     }
  343.  
  344.     if {[info exists menubar_map($itemlabel)]} {
  345.         return [subst $menubar_map($itemlabel)]
  346.     } else {
  347.         return ""
  348.     }
  349. }
  350.  
  351.